home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb29.arc / TURBLE.LBR / BEEDEMO.PQS / beedemo.pas
Pascal/Delphi Source File  |  1985-03-03  |  3KB  |  125 lines
  1. {$iturble.pas}
  2. {$iturble2.pas}
  3. {$ipaint.pas}
  4. {$igetput.pas}
  5.  
  6. Var
  7.   Bee : Storage;
  8.   TX, TY, Counter : Integer;
  9.   InBeeName  : String[14];
  10.   OutBeeName : String[14];
  11.   Ch : Char;
  12.  
  13. Procedure Startup;                {Turn on graphics mode and move to start.  }
  14. begin
  15.   Mode(CMR);
  16.   Pencolor(None);
  17.   MoveTo(65,50);
  18.   PenColor(on);
  19.   TX := StartX; TY := StartY;
  20. end;
  21.  
  22. Function ExistBee : Boolean;      {See if file exists and set filenames.     }
  23. Var
  24.   OK : Boolean;
  25.   BeeFile : File;
  26.  
  27. begin
  28.   InBeeName  := 'BEE.FIG';
  29.   OutBeeName := '';
  30.   Assign(BeeFile,InBeeName);
  31.   {$I-} Reset(BeeFile) {$I+};
  32.   OK := (IOResult = 0);
  33.   If not OK then
  34.     begin
  35.       InBeeName  := '';
  36.       OutBeeName := 'BEE.FIG';
  37.       ExistBee   := False;
  38.     end
  39.   else ExistBee := True;
  40. end;
  41.  
  42. Procedure DrawCircles;            {Draw the circles.                         }
  43. begin
  44.   Circle(21);
  45.   RCircle(26);
  46.   LCircle(26);
  47.   CCircle(40);
  48. end;
  49.  
  50. Procedure PaintCircles;           {Paint them.                               }
  51. begin
  52.   TX := StartX; TY := StartY;
  53.   Paint(TX + 2,TY,1,1);
  54.   Paint(TX - 2,TY,1,1);
  55.   Paint(TX,TY - 16,1,3);
  56.   Paint(TX,TY + 16,1,3);
  57.   Paint(TX + 23,TY,1,2);
  58.   Paint(TX - 23,TY,1,2);
  59.   Paint(TX + 48,TY,1,3);
  60.   Paint(TX - 48,TY,1,3);
  61. end;
  62.  
  63. Procedure DrillEyes;              {Draw and paint blank circles in center.   }
  64. begin
  65.   Pencolor(None);
  66.   Turn(-90);
  67.   Go(10);
  68.   Pencolor(2);
  69.   Circle(6);
  70.   Pencolor(None);
  71.   Go(-20);
  72.   Pencolor(2);
  73.   Circle(6);
  74.   PenColor(None);
  75.   Go(10);
  76.   PenColor(2);
  77.   Paint(TX - 6,TY,2,0);
  78.   Paint(TX + 6,TY,2,0);
  79. end;
  80.  
  81. Procedure MakeBee;                {Make the Bee and save it to a file.       }
  82. begin
  83.   DrawCircles;
  84.   PaintCircles;
  85.   DrillEyes;
  86.   TX := TX - 60; TY := TY - 45;
  87.   Get(TX,TY,120,90,Bee,OutBeeName);
  88.   Read(Kbd,Ch);
  89. end;
  90.  
  91. Procedure MoveFast;               {Move fast down using...                   }
  92. begin                             {...BLANK and EQUAL operators.             }
  93.   For Counter := 1 to 35 do
  94.     begin
  95.       TX := TX + 5; TY := TY + 4;
  96.       Put(Bee,TX,TY,e,'');
  97.       Put(Bee,TX,TY,b,'');
  98.     end;
  99.   Put(Bee,TX + 5,TY + 4,e,'');
  100.   Read(Kbd,Ch);
  101. end;
  102.  
  103. Procedure MoveSlow;               {Move slow back up using XOR operator.     }
  104. begin
  105.   For Counter := 1 to 6 do
  106.     begin
  107.       TX := TX - 15; TY := TY - 12;
  108.       Put(Bee,TX,TY,x,'');
  109.       Put(Bee,TX,TY,x,'');
  110.     end;
  111.   Put(Bee,TX + 5,TY + 4,x,'');
  112.   Read(Kbd,Ch);
  113. end;
  114.  
  115. begin
  116.   Startup;
  117.   If not ExistBee then MakeBee;   {Make and save the bee if it doesn't exist.}
  118.   Put(Bee,TX,TY,b,InBeeName);     {Put it down from file it if does.         }
  119.   MoveFast;
  120.   Put(Bee,TX + 5,TY + 4,x,'');
  121.   MoveSlow;
  122.   Mode(bw80);
  123. end.
  124.  
  125.